home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AmigActive 10
/
AACD 10.iso
/
AACD
/
Programming
/
AmigaTalk
/
Intuition
/
Gadget.st
< prev
next >
Wrap
Text File
|
2000-05-03
|
11KB
|
386 lines
"------------------------------------------------------------------"
" Gadget Class is an abstract class. The user has to use the other"
" classes in this file for concrete Amiga Gadgets. "
"------------------------------------------------------------------"
Class Gadget :Glyph
! gadgetType gadgetName !
[
gadgetTypeIs
gadgetType <- <primitive 183 2 0 6 gadgetName>.
(gadgetType == nil) "NOT a BoolGadget, Check some more:"
ifTrue: [gadgetType <- <primitive 183 2 1 6 gadgetName>.
(gadgetType == nil) "Has to be a PropGadget:"
ifTrue: [gadgetType <- <primitive 183 2 2 6 gadgetName>]
].
^ gadgetType
|
gadgetNameIs
^ gadgetName
|
new: newGadgetName
<primitive 183 1 0 newGadgetName>.
gadgetName <- newGadgetName.
^ self
]
"-----------------------------------------------------------------------"
" BoolGadget Class implements messages specific only to boolean gadgets."
"-----------------------------------------------------------------------"
Class BoolGadget :Gadget
!
leftEdge topEdge width height flags activation gadgetType gadgetID
iTextName nextGadgetName renderName selectName gadgetName
!
[
new: newGadgetName
super new: newGadgetName.
gadgetName <- super gadgetNameIs.
^ self
|
remove
<primitive 183 0 0 gadgetName>
|
registerTo: windowTitle
<primitive 183 7 0 windowTitle gadgetName>
|
setStartPoint: newPoint ! x y ! "newPoint is leftEdge @ topEdge"
x <- newPoint x.
y <- newPoint y.
<primitive 183 3 0 0 x gadgetName>.
<primitive 183 3 0 1 y gadgetName>.
leftEdge <- x.
topEdge <- y
|
setGadgetSizeTo: sizePoint ! w h ! "sizePoint is width @ height"
w <- sizePoint x.
h <- sizePoint y.
<primitive 183 3 0 2 w gadgetName>.
<primitive 183 3 0 3 h gadgetName>.
width <- w.
height <- h
|
getStartPoint
leftEdge <- <primitive 183 2 0 0 gadgetName>.
topEdge <- <primitive 183 2 0 1 gadgetName>.
^ leftEdge @ topEdge
|
getGadgetSize
width <- <primitive 183 2 0 2 gadgetName>.
height <- <primitive 183 2 0 3 gadgetName>.
^ width @ height
|
getFlags
^ flags <- <primitive 183 2 0 4 gadgetName>
|
setFlags: newFlags
<primitive 183 3 0 4 newFlags gadgetName>.
flags <- newFlags
|
getActivation
^ activation <- <primitive 183 2 0 5 gadgetName>
|
setActivation: newActivation
<primitive 183 3 0 5 newActivation gadgetName>.
activation <- newActivation
|
"only needed because of GZZGADGET & REQGADGET type flags."
getGadgetType
^ gadgetType <- <primitive 183 2 0 6 gadgetName>
|
"only needed because of GZZGADGET & REQGADGET type flags."
setGadgetType: newGadgetType
<primitive 183 3 0 6 newGadgetType gadgetName>.
gadgetType <- newGadgetType
|
getGadgetID
^ gadgetID <- <primitive 183 2 0 7 gadgetName>
|
setGadgetID: newGadgetID
<primitive 183 3 0 7 newGadgetID gadgetName>.
gadgetID <- newGadgetID
|
getNextGadgetName
^ nextGadgetName <- <primitive 183 2 0 8 gadgetName>
|
setNextGadgetName: newNextGadgetName
<primitive 183 3 0 8 newNextGadgetName gadgetName>.
nextGadgetName <- newNextGadgetName
|
getITextName
^ iTextName <- <primitive 183 2 0 9 gadgetName>
|
setITextName: newITextName
<primitive 183 3 0 9 newITextName gadgetName>.
iTextName <- newITextName
|
getRenderName
^ renderName <- <primitive 183 2 0 10 gadgetName>
|
setRenderName: newRenderName
<primitive 183 3 0 10 newRenderName gadgetName>.
renderName <- newRenderName
|
getSelectName
^ selectName <- <primitive 183 2 0 11 gadgetName>
|
setSelectName: newSelectName
<primitive 183 3 0 11 newSelectName gadgetName>.
selectName <- newSelectName
]
"---------------------------------------------------------------------"
" StrGadget Class implements messages specific only to string gadgets."
"---------------------------------------------------------------------"
Class StrGadget :Gadget
!
leftEdge topEdge width height flags activation gadgetType gadgetID
iTextName nextGadgetName renderName selectName bufferSize gadgetName
!
[
changeBufferSize: newSize
<primitive 183 5 newSize gadgetName>.
bufferSize <- newSize
|
getBufferSize
^ bufferSize <- <primitive 183 2 1 12 gadgetName>
|
remove
<primitive 183 0 1 gadgetName>
|
registerTo: windowTitle
<primitive 183 7 1 windowTitle gadgetName>
|
setStartPoint: newPoint ! x y !
x <- newPoint x.
y <- newPoint y.
<primitive 183 3 1 0 x gadgetName>.
<primitive 183 3 1 1 y gadgetName>.
leftEdge <- x.
topEdge <- y
|
setGadgetSize: sizePoint ! w h !
w <- sizePoint x.
h <- sizePoint y.
<primitive 183 3 1 2 w gadgetName>.
<primitive 183 3 1 3 h gadgetName>.
width <- w.
height <- h
|
getStartPoint
leftEdge <- <primitive 183 2 1 0 gadgetName>.
topEdge <- <primitive 183 2 1 1 gadgetName>.
^ leftEdge @ topEdge
|
getGadgetSize
width <- <primitive 183 2 1 2 gadgetName>.
height <- <primitive 183 2 1 3 gadgetName>.
^ width @ height
|
getFlags
^ flags <- <primitive 183 2 1 4 gadgetName>
|
setFlags: newFlags
<primitive 183 3 1 4 newFlags gadgetName>.
flags <- newFlags
|
getActivation
^ activation <- <primitive 183 2 1 5 gadgetName>
|
setActivation: newActivation
<primitive 183 3 1 5 newActivation gadgetName>.
activation <- newActivation
|
"only needed because of GZZGADGET & REQGADGET type flags."
getGadgetType
^ gadgetType <- <primitive 183 2 1 6 gadgetName>
|
setGadgetType: newGadgetType
<primitive 183 3 1 6 newGadgetType gadgetName>.
gadgetType <- newGadgetType
|
getGadgetID
^ gadgetID <- <primitive 183 2 1 7 gadgetName>
|
setGadgetID: newGadgetID
<primitive 183 3 1 7 newGadgetID gadgetName>.
gadgetID <- newGadgetID
|
getNextGadgetName
^ nextGadgetName <- <primitive 183 2 1 8 gadgetName>
|
setNextGadgetName: newNextGadgetName
<primitive 183 3 1 8 newNextGadgetName gadgetName>.
nextGadgetName <- newNextGadgetName
|
getITextName
^ iTextName <- <primitive 183 2 1 9 gadgetName>
|
setITextName: newITextName
<primitive 183 3 1 9 newITextName gadgetName>.
iTextName <- newITextName
|
getRenderName
^ renderName <- <primitive 183 2 1 10 gadgetName>
|
setRenderName: newRenderName
<primitive 183 3 1 10 newRenderName gadgetName>.
renderName <- newRenderName
|
getSelectName
^ selectName <- <primitive 183 2 1 11 gadgetName>
|
setSelectName: newSelectName
<primitive 183 3 1 11 newSelectName gadgetName>.
selectName <- newSelectName
|
new: newGadgetName
super new: newGadgetName.
gadgetName <- super gadgetNameIs.
self setGadgetType: 1.
^ self
]
"------------------------------------------------------"
" PropGadget Class implements messages specific only to"
" proportional gadgets. "
"------------------------------------------------------"
Class PropGadget :Gadget
!
leftEdge topEdge width height flags activation gadgetType gadgetID
iTextName nextGadgetName renderName selectName propFlags hPot
vPot hBody vBody gadgetName
!
[
modifyProps: newFlags hPot: hp vPot: vp hBody: hb
vBody: vb windowName: windowTitle
<primitive 183 4 newFlags hp vp hb vb windowTitle gadgetName>.
flags <- newFlags.
hPot <- hp.
vPot <- vp.
hBody <- hb.
vBody <- vb
|
setProps: newFlags hPot: hp vPot: vp hBody: hb vBody: vb
<primitive 183 6 newFlags hp vp hb vb gadgetName>.
flags <- newFlags.
hPot <- hp.
vPot <- vp.
hBody <- hb.
vBody <- vb
|
remove
<primitive 183 0 2 gadgetName>
|
registerTo: windowTitle
<primitive 183 7 2 windowTitle gadgetName>
|
setStartPoint: newPoint ! x y !
x <- newPoint x.
y <- newPoint y.
<primitive 183 3 2 0 x gadgetName>.
<primitive 183 3 2 1 y gadgetName>.
leftEdge <- x.
topEdge <- y
|
setGadgetSize: sizePoint ! w h !
w <- sizePoint x.
h <- sizePoint y.
<primitive 183 3 2 2 w gadgetName>.
<primitive 183 3 2 3 h gadgetName>.
width <- w.
height <- h
|
getStartPoint
leftEdge <- <primitive 183 2 2 0 gadgetName>.
topEdge <- <primitive 183 2 2 1 gadgetName>.
^ leftEdge @ topEdge
|
getGadgetSize
width <- <primitive 183 2 2 2 gadgetName>.
height <- <primitive 183 2 2 3 gadgetName>.
^ width @ height
|
getFlags
^ flags <- <primitive 183 2 2 4 gadgetName>
|
setFlags: newFlags
<primitive 183 3 2 4 newFlags gadgetName>.
flags <- newFlags
|
getActivation
^ activation <- <primitive 183 2 2 5 gadgetName>
|
setActivation: newActivation
<primitive 183 3 2 5 newActivation gadgetName>.
activation <- newActivation
|
"only needed because of GZZGADGET & REQGADGET type flags."
getGadgetType
^ gadgetType <- <primitive 183 2 2 6 gadgetName>
|
"only needed because of GZZGADGET & REQGADGET type flags."
setGadgetType: newGadgetType
<primitive 183 3 2 6 newGadgetType gadgetName>.
gadgetType <- newGadgetType
|
getGadgetID
^ gadgetID <- <primitive 183 2 2 7 gadgetName>
|
setGadgetID: newGadgetID
<primitive 183 3 2 7 newGadgetID gadgetName>.
gadgetID <- newGadgetID
|
getNextGadgetName
^ nextGadgetName <- <primitive 183 2 2 8 gadgetName>
|
setNextGadgetName: newNextGadgetName
<primitive 183 3 2 8 newNextGadgetName gadgetName>.
nextGadgetName <- newNextGadgetName
|
getITextName
^ iTextName <- <primitive 183 2 2 9 gadgetName>
|
setITextName: newITextName
<primitive 183 3 2 9 newITextName gadgetName>.
iTextName <- newITextName
|
getRenderName
^ renderName <- <primitive 183 2 2 10 gadgetName>
|
setRenderName: newRenderName
<primitive 183 3 2 10 newRenderName gadgetName>.
renderName <- newRenderName
|
getSelectName
^ selectName <- <primitive 183 2 2 11 gadgetName>
|
setSelectName: newSelectName
<primitive 183 3 2 11 newSelectName gadgetName>.
selectName <- newSelectName
|
getPropFlags
^ propFlags <- <primitive 183 2 2 13 gadgetName>
|
getHPot
^ hPot <- <primitive 183 2 2 14 gadgetName>
|
getVPot
^ vPot <- <primitive 183 2 2 15 gadgetName>
|
getHBody
^ hBody <- <primitive 183 2 2 16 gadgetName>
|
getVBody
^ vBody <- <primitive 183 2 2 17 gadgetName>
|
new: newGadgetName
super new: newGadgetName.
gadgetName <- super gadgetNameIs.
self setGadgetType: 2.
^ self
]